home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / COBOL / H309.ZIP / PSICO.ZIP / PSICO12.EXE / BINTREE.STR next >
Text File  |  1988-09-27  |  9KB  |  272 lines
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID.  BINTREE.
  3.        ENVIRONMENT DIVISION.
  4.        CONFIGURATION SECTION.
  5.        SOURCE-COMPUTER.  ANY-COMPUTER.
  6.        OBJECT-COMPUTER.  ANY-COMPUTER.
  7.        INPUT-OUTPUT SECTION.
  8.        FILE-CONTROL.
  9.            SELECT IN-FILE ASSIGN DISK
  10.                   DELIMITER STANDARD.
  11.       *
  12.        DATA DIVISION.
  13.        FILE SECTION.
  14.  
  15.       *
  16.        FD  IN-FILE
  17.            LABEL RECORDS STANDARD
  18.            VALUE OF FILE-ID  INFILE-NAME.
  19.        01  IN-RECORD                     PIC X(20).
  20.  
  21.       *
  22.        WORKING-STORAGE SECTION.
  23.        01  INFILE-NAME                   PIC X(14).
  24.        01  BA-PSV                        PIC S9(4) COMP.
  25.        01  STACK-POINTER                 PIC S9(4) COMP.
  26.        01  ARRAYS.
  27.            03  STATE-VARIABLE            OCCURS 100
  28.                                          PIC S9(4) COMP.
  29.            03  SAVED-POINTER             OCCURS 100
  30.                                          PIC S9(4) COMP.
  31.        01  WS-EOF                        PIC 9.
  32.            88  END-OF-FILE               VALUE 1.
  33.        01  ITEM-INDEX                    PIC S9(4) COMP.
  34.        01  CURRENT-POINTER               PIC S9(4) COMP.
  35.        01  OWNER-POINTER                 PIC S9(4) COMP.
  36.        01  WS-TYPE                       PIC X.
  37.        01  WS-OPT                        PIC X.
  38.        01  TREE-STRUCTURE.
  39.            03  TREE-BRANCH               OCCURS 100.
  40.                05  LEFT-POINTER          PIC S9(4) COMP.
  41.                05  RIGHT-POINTER         PIC S9(4) COMP.
  42.                05  ITEM                  PIC X(20).
  43.       *
  44.       *
  45.        PROCEDURE DIVISION.
  46.        PROC AA-MAIN
  47.        PROCBEGIN
  48.       *
  49.       *    This procedure passes every record on the input file to a
  50.       *    multi-state routine which builds them into a binary tree.
  51.       *
  52.       *    At the end of input, the program will accept a code
  53.       *    and will display the data in appropriate sequence
  54.       *    using recursive routines to read the tree in the correct order
  55.       *
  56.       *        A for ascending sequence
  57.       *        D for descending sequence
  58.       *        F for finish
  59.       *
  60.        SEQUENCE
  61.            DISPLAY "Enter filename, must be in current directory "
  62.            ACCEPT INFILE-NAME
  63.            OPEN INPUT IN-FILE
  64.            MOVE ZERO TO WS-EOF
  65.       *
  66.       *    Note the read-ahead technique, ie read the first record
  67.       *    before entering the loop. The loop logic is then
  68.       *
  69.       *        until end of file
  70.       *              process current record
  71.       *              read next
  72.       *        repeat
  73.       *
  74.       *    This technique can often simplify and improve programs
  75.       *
  76.            READ IN-FILE
  77.               AT END MOVE 1 TO WS-EOF.
  78.  
  79.            ITERUNTIL END-OF-FILE
  80.            BEGIN
  81.                PERFORM BA-BUILD-TREE
  82.                READ IN-FILE
  83.                     AT END MOVE 1 TO WS-EOF.
  84.            REPEAT
  85.  
  86.            CLOSE IN-FILE.
  87.  
  88.            PERFORM BA-BUILD-TREE
  89.  
  90.            MOVE "X" TO WS-OPT
  91.            ITERUNTIL WS-OPT = "F"
  92.            BEGIN
  93.                DISPLAY "Enter A (ascending),"
  94.                        " D (descending) or F (finish) "
  95.                ACCEPT  WS-OPT
  96.                MOVE 0 TO STACK-POINTER
  97.                MOVE 1 TO CURRENT-POINTER
  98.                SELECT
  99.                CASE WS-OPT = "A"
  100.                BEGIN
  101.                   PERFORM CA-PRINT-TREE
  102.  
  103.                CASE WS-OPT = "D"
  104.                BEGIN
  105.                    PERFORM DA-PRINT-TREE
  106.  
  107.                FI
  108.             REPEAT
  109.  
  110.             STOP RUN
  111.             FI
  112.        PROCEND
  113.  
  114.        IPROC BA-BUILD-TREE
  115.        PSVNAME BA-PSV
  116.        PROCBEGIN
  117.            SEQUENCE
  118.       *
  119.       *    This is a multi-state routine which builds the binary tree.
  120.       *    It is called each time a record is read, and inserts it into
  121.       *    the correct place in the tree.
  122.       *
  123.       *    Put the first item into the tree
  124.            MOVE 1          TO ITEM-INDEX
  125.            MOVE IN-RECORD  TO ITEM (ITEM-INDEX)
  126.            MOVE ZERO       TO LEFT-POINTER (ITEM-INDEX)
  127.                               RIGHT-POINTER (ITEM-INDEX)
  128.            MOVE 1          TO CURRENT-POINTER
  129.       *
  130.       *    Return to calling routine to get the next record
  131.       *
  132.            SREAD
  133.       *
  134.            ITERUNTIL END-OF-FILE
  135.            BEGIN
  136.              SELECT CASE ITEM-INDEX > 99
  137.              BEGIN
  138.                  DISPLAY "Too many items in file (max 100)"
  139.                  DISPLAY IN-RECORD " ignored "
  140.              OTHERWISE
  141.                ADD 1          TO ITEM-INDEX
  142.                MOVE IN-RECORD TO ITEM (ITEM-INDEX)
  143.                MOVE ZERO      TO LEFT-POINTER (ITEM-INDEX)
  144.                                  RIGHT-POINTER (ITEM-INDEX)
  145.  
  146.                MOVE 1 TO CURRENT-POINTER
  147.                ITERUNTIL CURRENT-POINTER = ZERO
  148.                BEGIN
  149.                    MOVE CURRENT-POINTER TO OWNER-POINTER
  150.                    SELECT
  151.                    CASE IN-RECORD < ITEM (CURRENT-POINTER)
  152.                    BEGIN
  153.                        MOVE LEFT-POINTER (CURRENT-POINTER)
  154.                             TO CURRENT-POINTER
  155.                        MOVE "L"    TO WS-TYPE
  156.                    CASE IN-RECORD = ITEM (CURRENT-POINTER)
  157.                    BEGIN
  158.                        DISPLAY "EQUAL KEYS MAY CAUSE ERRORS"
  159.                        MOVE LEFT-POINTER (CURRENT-POINTER)
  160.                             TO CURRENT-POINTER
  161.                        MOVE "L"    TO WS-TYPE
  162.                    OTHERWISE
  163.                        MOVE RIGHT-POINTER (CURRENT-POINTER)
  164.                             TO CURRENT-POINTER
  165.                        MOVE "R"     TO WS-TYPE
  166.                    FI
  167.                 REPEAT
  168.  
  169.                 MOVE IN-RECORD     TO ITEM (ITEM-INDEX)
  170.                 SELECT
  171.                 CASE WS-TYPE = "L"
  172.                 BEGIN
  173.                     MOVE ITEM-INDEX
  174.                       TO LEFT-POINTER (OWNER-POINTER)
  175.                 OTHERWISE
  176.                     MOVE ITEM-INDEX
  177.                       TO RIGHT-POINTER (OWNER-POINTER)
  178.                 FI
  179.              FI
  180.       *
  181.       *    Get the next record from the calling routine
  182.       *
  183.               SREAD
  184.  
  185.             REPEAT
  186.          FI
  187.        PROCEND
  188.  
  189.  
  190.        RPROC CA-PRINT-TREE
  191.        PSVNAME STATE-VARIABLE
  192.        PSVTHREAD STACK-POINTER
  193.        PROCBEGIN
  194.       *
  195.       *   This is a recursive routine which reads the tree, displaying
  196.       *   the contents in ascending sequence.
  197.       *
  198.       *   The verb RCALL performs the recursive call
  199.       *
  200.             MOVE CURRENT-POINTER TO SAVED-POINTER (STACK-POINTER)
  201.  
  202.       *
  203.       *     Process the left branch
  204.       *
  205.             SELECT
  206.                CASE LEFT-POINTER (CURRENT-POINTER) > 0
  207.                BEGIN
  208.                    MOVE LEFT-POINTER (CURRENT-POINTER)
  209.                      TO CURRENT-POINTER
  210.                    RCALL
  211.                FI
  212.       *
  213.       *    Now display the current item
  214.       *
  215.            MOVE SAVED-POINTER (STACK-POINTER) TO CURRENT-POINTER
  216.            DISPLAY ITEM (CURRENT-POINTER)
  217.  
  218.       *
  219.       *    Process the right branch
  220.       *
  221.            SELECT
  222.               CASE RIGHT-POINTER (CURRENT-POINTER) > 0
  223.               BEGIN
  224.                  MOVE RIGHT-POINTER (CURRENT-POINTER)
  225.                    TO CURRENT-POINTER
  226.                  RCALL
  227.            FI
  228.  
  229.        PROCEND
  230.  
  231.        RPROC DA-PRINT-TREE
  232.        PSVNAME STATE-VARIABLE
  233.        PSVTHREAD STACK-POINTER
  234.        PROCBEGIN
  235.       *
  236.       *   This is a recursive routine which reads the tree, displaying
  237.       *   the contents in descending sequence.
  238.       *
  239.       *   The verb RCALL performs the recursive call
  240.       *
  241.             MOVE CURRENT-POINTER TO SAVED-POINTER (STACK-POINTER)
  242.  
  243.       *
  244.       *     Process the RIGHT branch
  245.       *
  246.             SELECT
  247.                CASE RIGHT-POINTER (CURRENT-POINTER) > 0
  248.                BEGIN
  249.                    MOVE RIGHT-POINTER (CURRENT-POINTER)
  250.                      TO CURRENT-POINTER
  251.                    RCALL
  252.                FI
  253.       *
  254.       *    Now display the current item
  255.       *
  256.            MOVE SAVED-POINTER (STACK-POINTER) TO CURRENT-POINTER
  257.            DISPLAY ITEM (CURRENT-POINTER)
  258.  
  259.       *
  260.       *    Process the LEFT branch
  261.       *
  262.            SELECT
  263.               CASE LEFT-POINTER (CURRENT-POINTER) > 0
  264.               BEGIN
  265.                  MOVE LEFT-POINTER (CURRENT-POINTER)
  266.                    TO CURRENT-POINTER
  267.                  RCALL
  268.            FI
  269.  
  270.        PROCEND
  271.        END PROGRAM BINTREE.
  272.